@@ -1,5 +1,11 @@
Revision history for System-Command
+1.03 Thu Mar 17 22:47:38 CET 2011
+ [ENHANCEMENTS]
+ - removed all the System::Command::Reaper logic which, while
+ being really nice, didn't actually add any value, and made
+ things more complex
+
1.02 Tue Mar 15 20:27:29 CET 2011
[FEATURES]
- new method is_terminated() allows to inquire about the child
@@ -1,7 +1,6 @@
Build.PL
Changes
lib/System/Command.pm
-lib/System/Command/Reaper.pm
Makefile.PL
MANIFEST This list of files
README
@@ -15,10 +15,7 @@ name: System-Command
provides:
System::Command:
file: lib/System/Command.pm
- version: 1.02
- System::Command::Reaper:
- file: lib/System/Command/Reaper.pm
- version: 1.01
+ version: 1.03
resources:
license: http://dev.perl.org/licenses/
-version: 1.02
+version: 1.03
@@ -1,146 +0,0 @@
-package System::Command::Reaper;
-
-use strict;
-use warnings;
-use 5.006;
-
-use Carp;
-use Scalar::Util qw( weaken );
-
-use constant HANDLES => qw( stdin stdout stderr );
-use constant STATUS => qw( exit signal core );
-
-our $VERSION = '1.01';
-
-sub new {
- my ($class, $command) = @_;
- my $self = bless { command => $command }, $class;
-
- # copy/weaken the important keys
- @{$self}{ pid => HANDLES } = @{$command}{ pid => HANDLES };
- weaken $self->{$_} for ( command => HANDLES );
-
- return $self;
-}
-
-sub reap {
- my ($self) = @_;
-
- # close all pipes
- my ( $in, $out, $err ) = @{$self}{qw( stdin stdout stderr )};
- $in and $in->opened and $in->close || carp "error closing stdin: $!";
- $out and $out->opened and $out->close || carp "error closing stdout: $!";
- $err and $err->opened and $err->close || carp "error closing stderr: $!";
-
- # and wait for the child (if any)
- if ( my $reaped = waitpid( $self->{pid}, 0 ) and !exists $self->{exit} ) {
- my $zed = $reaped == $self->{pid};
- carp "Child process already reaped, check for a SIGCHLD handler"
- if !$zed && !$System::Command::QUIET;
-
- # check $?
- @{$self}{ STATUS() }
- = $zed
- ? ( $? >> 8, $? & 127, $? & 128 )
- : ( -1, -1, -1 );
-
- # does our creator still exist?
- @{ $self->{command} }{ STATUS() } = @{$self}{ STATUS() }
- if defined $self->{command};
- }
-
- return $self;
-}
-
-sub DESTROY {
- my ($self) = @_;
- $self->reap if !exists $self->{exit};
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-System::Command::Reaper - Reap processes started by System::Command
-
-=head1 SYNOPSIS
-
-This class is used for internal purposes.
-Move along, nothing to see here.
-
-=head1 DESCRIPTION
-
-The C<System::Command> objects delegate the reaping of child
-processes to C<System::Command::Reaper> objects. This allows a user
-to create a C<System::Command> and discard it after having obtained
-one or more references to its handles connected to the child process.
-
-The typical use case looks like this:
-
- my $fh = System::Command->new( @cmd )->stdout();
-
-The child process is reaped either through a direct call to C<close()>
-or when the command object and all its handles have been destroyed,
-thus avoiding zombies (which would be reaped by the system at the end
-of the main program).
-
-This is possible thanks to the following reference graph:
-
- System::Command
- | | | ^|
- v v v !|
- in out err !|
- ^| ^| ^| !|
- !v !v !v !v
- System::Command::Reaper
-
-Legend:
- | normal ref
- ! weak ref
-
-The C<System::Command::Reaper> object acts as a sentinel, that takes
-care of reaping the child process when the original C<System::Command>
-and its filehandles have been destroyed (or when C<System::Command>
-C<close()> method is being called).
-
-=head1 METHODS
-
-C<System::Command::Reaper> supports the following methods:
-
-=head2 new( $command )
-
-Create a new C<System::Command::Reaper> object attached to the
-C<System::Command> object passed as a parameter.
-
-=head2 reap()
-
-Close all the opened filehandles of the main C<System::Command> object,
-reaps the child process, and updates the main object with the status
-information of the child process.
-
-C<DESTROY> calls C<reap()> when the sentinel is being destroyed.
-
-=head1 AUTHOR
-
-Philippe Bruhat (BooK), C<< <book at cpan.org> >>
-
-=head1 ACKNOWLEDGEMENTS
-
-This scheme owes a lot to Vincent Pit who on #perlfr provided the
-general idea (use a proxy to delay object destruction and child process
-reaping) with code examples, which I then adapted to my needs.
-
-
-=head1 COPYRIGHT
-
-Copyright 2010-2011 Philippe Bruhat (BooK), all rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
@@ -10,12 +10,10 @@ use IO::Handle;
use IPC::Open3 qw( open3 );
use List::Util qw( reduce );
-use System::Command::Reaper;
-
use POSIX ":sys_wait_h";
use constant STATUS => qw( exit signal core );
-our $VERSION = '1.02';
+our $VERSION = '1.03';
# Trap the real STDIN/ERR/OUT file handles in case someone
# *COUGH* Catalyst *COUGH* screws with them which breaks open3
@@ -136,10 +134,6 @@ sub new {
stderr => $err,
}, $class;
- # create the subprocess reaper and link the handles and command to it
- ${*$in} = ${*$out} = ${*$err} = $self->{reaper} # typeglobs FTW
- = System::Command::Reaper->new($self);
-
return $self;
}
@@ -156,12 +150,19 @@ sub is_terminated {
return $pid if !kill 0, $pid and exists $self->{exit};
# If that is a re-animated body, we're gonna have to kill it.
- if ( my $reaped = waitpid( $pid, WNOHANG ) ) {
+ return $self->_reap(WNOHANG);
+}
+
+sub _reap {
+ my ( $self, @flags ) = @_;
+ my $pid = $self->{pid};
+
+ if ( my $reaped = waitpid( $pid, @flags ) and !exists $self->{exit} ) {
my $zed = $reaped == $pid;
carp "Child process already reaped, check for a SIGCHLD handler"
if !$zed && !$QUIET;
- @{$self}{ STATUS() } = @{ $self->{reaper} }{ STATUS() }
+ @{$self}{ STATUS() }
= $zed
? ( $? >> 8, $? & 127, $? & 128 )
: ( -1, -1, -1 );
@@ -173,8 +174,20 @@ sub is_terminated {
return;
}
-# delegate close() to the reaper
-sub close { $_[0]{reaper}->reap() }
+sub close {
+ my ($self) = @_;
+
+ # close all pipes
+ my ( $in, $out, $err ) = @{$self}{qw( stdin stdout stderr )};
+ $in and $in->opened and $in->close || carp "error closing stdin: $!";
+ $out and $out->opened and $out->close || carp "error closing stdout: $!";
+ $err and $err->opened and $err->close || carp "error closing stderr: $!";
+
+ # and wait for the child (if any)
+ $self->_reap();
+
+ return $self;
+}
1;
@@ -274,7 +287,6 @@ attributes defined (see below).
Close all pipes to the child process, collects exit status, etc.
and defines a number of attributes (see below).
-
=head2 is_terminated()
Returns a true value if the underlying process was terminated.
@@ -398,9 +410,6 @@ why it was not an independent module. This module was started by
taking out of C<Git::Repository::Command> 1.08 the parts that
weren't related to Git.
-The C<System::Command::Reaper> class was added after the addition
-of C<Git::Repository::Command::Reaper> in C<Git::Repository::Command> 1.11.
-
=head1 BUGS
@@ -13,42 +13,37 @@ my @cmd = ( $^X, File::Spec->catfile( t => 'lines.pl' ) );
my @destroyed;
{
no strict 'refs';
- for my $suffix ( '', '::Reaper' ) {
- my $class = "System::Command$suffix";
+ my $class = "System::Command";
my $destroy = *{"$class\::DESTROY"}{CODE};
*{"$class\::DESTROY"} = sub {
diag "DESTROY $_[0]";
push @destroyed, refaddr $_[0];
$destroy->(@_) if $destroy;
};
- }
}
# test various scope situations and object destruction time
-my ( $cmd_addr, $reap_addr );
+my ( $cmd_addr );
# test 1
-BEGIN { $tests += 6 }
+BEGIN { $tests += 5 }
{
my $cmd = System::Command->new(@cmd);
$cmd_addr = refaddr $cmd;
- $reap_addr = refaddr $cmd->{reaper};
my ( $out, $err ) = ( $cmd->stdout, $cmd->stderr );
ok( eof $out, 'No output' );
ok( eof $err, 'No errput' );
is( scalar @destroyed, 0, "Destroyed no object yet" );
}
-is( scalar @destroyed, 2, "Destroyed 2 objects" );
+is( scalar @destroyed, 1, "Destroyed 1 object" );
is( shift @destroyed, $cmd_addr, "... command object was destroyed" );
-is( shift @destroyed, $reap_addr, "... reaper object was destroyed" );
@destroyed = ();
# test 2
-BEGIN { $tests += 6 }
+BEGIN { $tests += 5 }
{
my $cmd = System::Command->new( @cmd, 1, 1, 1 );
$cmd_addr = refaddr $cmd;
- $reap_addr = refaddr $cmd->{reaper};
{
my $fh = $cmd->stdout;
@@ -62,37 +57,35 @@ BEGIN { $tests += 6 }
}
is( scalar @destroyed, 0, "Destroyed no object yet" );
}
-is( scalar @destroyed, 2, "Destroyed 2 objects" );
+is( scalar @destroyed, 1, "Destroyed 1 objects" );
is( shift @destroyed, $cmd_addr, "... command object was destroyed" );
-is( shift @destroyed, $reap_addr, "... reaper object was destroyed" );
@destroyed = ();
# test 3
BEGIN { $tests += 3 }
{
my $fh = System::Command->new( @cmd, 1 )->stdout;
- is( scalar @destroyed, 1, "Destroyed 1 object (command)" );
+ is( scalar @destroyed, 1, "Destroyed 1 object" );
@destroyed = ();
my $ln = <$fh>;
is( $ln, "STDOUT line 1\n", 'scope: { $fh = cmd->fh }' );
}
-is( scalar @destroyed, 1, "Destroyed 1 object (reaper)" );
+is( scalar @destroyed, 0, "Destroyed no object" );
@destroyed = ();
# test 4
BEGIN { $tests += 1 }
System::Command->new(@cmd);
-is( scalar @destroyed, 2, "Destroyed 2 objects (command + reaper)" );
+is( scalar @destroyed, 1, "Destroyed 1 object (command)" );
@destroyed = ();
# test 5
-BEGIN { $tests += 5 }
+BEGIN { $tests += 4 }
{
my $fh;
{
my $cmd = System::Command->new( @cmd, 2 );
$cmd_addr = refaddr $cmd;
- $reap_addr = refaddr $cmd->{reaper};
$fh = $cmd->stdout;
}
is( scalar @destroyed, 1, "Destroyed 1 object (command)" );
@@ -104,16 +97,14 @@ STDOUT line 1
STDOUT line 2
OUT
}
-is( scalar @destroyed, 1, "Destroyed 1 objects (reaper)" );
-is( shift @destroyed, $reap_addr, "... reaper object was destroyed" );
+is( scalar @destroyed, 0, "Destroyed no objects (reaper)" );
@destroyed = ();
# test 6
-BEGIN { $tests += 6 }
+BEGIN { $tests += 5 }
{
my $cmd = System::Command->new( @cmd, 1, 2, 2, 1 );
$cmd_addr = refaddr $cmd;
- $reap_addr = refaddr $cmd->{reaper};
{
my $fh = $cmd->stdout;
@@ -135,9 +126,8 @@ ERR
}
is( scalar @destroyed, 0, "Destroyed no object yet" );
}
-is( scalar @destroyed, 2, "Destroyed 2 objects" );
+is( scalar @destroyed, 1, "Destroyed 1 objects" );
is( shift @destroyed, $cmd_addr, "... command object was destroyed" );
-is( shift @destroyed, $reap_addr, "... reaper object was destroyed" );
@destroyed = ();
# test 7
@@ -159,6 +149,6 @@ STDERR line 2
STDERR line 3
ERR
}
-is( scalar @destroyed, 1, "Destroyed reaper object" );
+is( scalar @destroyed, 0, "Destroyed neaper object" );
@destroyed = ();